unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, MSHTML, ActiveX;

type
  TauthForm = class(TForm)
    browser: TWebBrowser;
    procedure FormCreate(Sender: TObject);
    procedure browserDocumentComplete(ASender: TObject; const pDisp: IDispatch;
      var URL: OleVariant);
    procedure browserNavigateComplete2(ASender: TObject; const pDisp: IDispatch;
      var URL: OleVariant);
    procedure FormDestroy(Sender: TObject);
  private
    FOleInPlaceActiveObject: IOleInPlaceActiveObject;
    procedure MsgHandler(var Msg: TMsg; var Handled: Boolean);
  public
    { Public declarations }
  end;

var
  authForm: TauthForm;

implementation


{$R *.dfm}




procedure TauthForm.MsgHandler(var Msg: TMsg; var Handled: Boolean);
const
  StdKeys = [VK_BACK, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT];
var IOIPAO: IOleInPlaceActiveObject;
  Dispatch: IDispatch;
begin
  if browser = nil then
  begin
    Handled := False;
    Exit;
  end;
  Handled := (IsDialogMessage(browser.Handle, Msg) = True);
  if (Handled) and (not browser.Busy) then
  begin
    if FOleInPlaceActiveObject = nil then
    begin
      Dispatch := browser.Application;
      if Dispatch <> nil then
      begin
        Dispatch.QueryInterface(IOleInPlaceActiveObject, IOIPAO);
        if IOIPAO <> nil then FOleInPlaceActiveObject := IOIPAO;
      end;
    end;
    if FOleInPlaceActiveObject <> nil then
      if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
        (Msg.wParam in StdKeys) then
        //nothing  -  do not pass on Backspace, Left, Right, Up, Down arrows
      else FOleInPlaceActiveObject.TranslateAccelerator(Msg);
  end;
end;




//Autofocus for Email field
procedure focusEmailField(browser: TWebBrowser);
var Doc: IHTMLDocument2;
    HTMLWindow: IHTMLWindow2;
begin

  // Get reference to current document
  Doc := browser.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;
  // Get parent window of current document
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  // Run JavaScript
  try
    HTMLWindow.execScript('javascript:document.getElementById("email").focus()', 'JavaScript'); // execute function
   // HTMLWindow.execScript('javascript:document.getElementById("login").onsubmit=function(){alert("ds");};', 'JavaScript');
  except
    // handle exception in case JavaScript fails to run
  end;

end;

procedure TauthForm.browserDocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
//focus on Ole Object
browser.OleObject.Document.parentWindow.focus;

//Autofocus for Email field
if StrLComp(Pansichar(AnsiString(URL)), 'http://vkontakte.ru/login.php', 29) = 0 then
    focusEmailField(browser);

end;

procedure TauthForm.browserNavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var document: IHTMLDocument2;
    cookies: String;
begin
document := browser.Document as IHTMLDocument2;
if Assigned(document) then begin
    cookies := document.cookie;
    if (Pos('remixsid', cookies) <> 0) and (Pos('remixsid=no', cookies)=0) then begin
      Writeln(cookies);
      Application.Terminate();
    end;
end;
end;

procedure TauthForm.FormCreate(Sender: TObject);
begin
Application.OnMessage := MsgHandler;
//on start - navigate to login in
browser.Navigate('http://vkontakte.ru/login.php');
end;

procedure TauthForm.FormDestroy(Sender: TObject);
begin
FOleInPlaceActiveObject := nil;
end;


initialization
  OleInitialize(nil);

finalization
  OleUninitialize
end.
